home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MATH / MATH1 / CFIT2.PAS < prev    next >
Pascal/Delphi Source File  |  1985-04-03  |  2KB  |  96 lines
  1. program cfit2;        { -> 142+147 }
  2. { plot service included }
  3. { Pascal program to perform a linear least-squares fit }
  4.  
  5. const    max    = 20;
  6.  
  7. type    index    = 1..max;
  8.     ary    = array[index] of real;
  9.  
  10. var    x,y,y_calc    : ary;
  11.     n        : integer;
  12.     first,done    : boolean;
  13.     seed,a,b    : real;
  14.  
  15. external procedure cls;
  16.  
  17. function random(dummy: integer): real;
  18. { random number 0-1 }
  19. { define seed=4.0 as global }
  20.  
  21. const    pi    = 3.14159;
  22.  
  23. var    x    : real;
  24.     i    : integer;
  25.  
  26. begin    { RANDOM }
  27.   x:=seed+pi;
  28.   x:=exp(5.0*ln(x));
  29.   seed:=x-trunc(x);
  30.   random:=seed
  31. end;    { RANDOM }
  32.  
  33.  
  34.  
  35. procedure get_data(var x,y: ary;
  36.            var n: integer);
  37. { get values for n and arrays x,y }
  38. { y is randomly scattered about a straight line }
  39.  
  40. const    a = 2.0;
  41.     b = 5.0;
  42.  
  43. var    i,j    : integer;
  44.     fudge    : real;
  45.  
  46. begin
  47.   write('Fudge? ');
  48.   readln(fudge);
  49.   if fudge<0.0 then done:=true
  50.   else
  51.     begin
  52.       repeat
  53.     write('How many points? ');
  54.     readln(n)
  55.       until (n>2) and (n<=max);
  56.       if first then first:=false else cls;
  57.       for i:=1 to n do
  58.     begin
  59.       j:=n+1-i;
  60.       x[i]:=j;
  61.       y[i]:=(a+b*j)*(1.0+(2.0*random(0)-1.0)*fudge)
  62.       end    { for-loop }
  63.     end        { if }
  64. end;        { procedure get_data }
  65.  
  66.  
  67. procedure write_data;
  68. { print out the answers }
  69. var    i    : integer;
  70.  
  71. begin
  72.   writeln;
  73.   writeln('  I      X      Y');
  74.   for i:=1 to n do
  75.     writeln(i:3,x[i]:8:1,y[i]:9:2);
  76.   writeln
  77. end;        { write_data }
  78.  
  79. {$I PLOT.LIB }
  80.  
  81. begin    { MAIN program }
  82.   first:=true;
  83.   cls;
  84.   seed:=4.0;
  85.   done:=false;
  86.   repeat
  87.     get_data(x,y,n);
  88.     if not done then
  89.       begin
  90.     write_data;
  91.     plot(x,y,y,-n);
  92.     { ***** --->  more lines to be added here ********* }
  93.     end
  94.   until done
  95. end.
  96.